HPAVC/HPAVC CD-ROM.iso/X3MDMO01.ZIP/PLASMA.PAS

Pascal/Delphi Source File | 1994-12-13 | 5KB | 271 lines

{
 ████       ████▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀
 ▀███▄     ▄███▀  Project: Plasma Effect [PASCAL]
     ▀███▄ ▄███▀    File   : PLASMA.PAS
         ▀█████▀      Version: 1.00        Created: 261194   Modified: 261194
        ▄███▀███▄
    ▄███▀   ▀███▄   Nice plasma effect by X3M Productions.
 ████       ████  If you have any questions, e-mail: [e-mail]
 ████       ████▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄
}

{$X+}
Uses
    Crt;

Type
    RGBType = Record
        R,G,B : Byte;
    End;
    PalType = Array[0..255] of RGBType;

Var
    TempPal, ToPal     : PalType;                                        { Temp and current palette }
    CosTbl                     : Array [0..255] of byte;         { Cosinus table }
    Pos1, Pos2,
    Pos3, Pos4            : Byte;                                                { Current positions }


{ This gives sets a color it's red, green and blue value }
Procedure SetCol(Col,R,G,B : Byte); Assembler;
Asm
    mov        dx,3c8h
    mov   al,[col]
    out   dx,al
    inc   dx
    mov   al,[r]
    out   dx,al
    mov   al,[g]
    out   dx,al
    mov   al,[b]
    out   dx,al
End;

{ Sets the entire palette. Very fast! }
Procedure SetPal(Var Palette : PalType); Assembler;
Asm
    push    ds
    lds   si, Palette
    mov   dx, 3c8h
    mov   al, 0
    out   dx, al
    inc   dx
    mov   cx, 768
    rep   outsb
    pop   ds
End;

{ Converts degrees to radians }
Function Rad(theta : Real) : Real;
Begin
    rad := theta * pi / 180
End;

{ Initialize colors }
Procedure InitColors;
Var
    i : Byte;
Begin
    For i:=0 to 63 do
    Begin
        TempPal[i].R             := 63;
        TempPal[i].G             := i;
        TempPal[i].B             := 63-i;
        TempPal[i+64].R     := 63-i;
        TempPal[i+64].G     := 63;
        TempPal[i+64].B     := i;
        TempPal[i+128].R     := 0;
        TempPal[i+128].G     := 63-i;
        TempPal[i+128].B     := 63;
        TempPal[i+192].R     := i;
        TempPal[i+192].G     := 0;
        TempPal[i+192].B     := 63;
    End;
End;

{ Initializes plasma colors and look-up table }
Procedure InitPlasma;
Var
    i : Byte;
Begin
    Asm
        mov        ax,0013h
        int      10h                                     { Enter mode 13 }
        cli
        mov   dx,3c4h
        mov   ax,604h                                 { Enter unchained mode }
        out   dx,ax
        mov   ax,0F02h                                { All planes }
        out   dx,ax
        mov   dx,3D4h
        mov   ax,14h                                        { Disable dword mode}
        out   dx,ax
        mov   ax,0E317h                                 { Enable byte mode.}
        out   dx,ax
        mov   al,9
        out   dx,al
        inc   dx
        in    al,dx
        and   al,0E0h                                       { Duplicate each scan 8 times.}
        add   al,7
        out   dx,al
    End;

    FillChar(ToPal,SizeOf(ToPal),0);                  { Clear pallette ToPal }
    SetPal(ToPal);

    { Set up cosinus look-up table }
    For i:=0 to 255 do
        CosTbl[i] := Round(Cos(Rad(i/360*255*2))*31)+32;

    InitColors;
End;

{ Draws the plasma on screen }
Procedure DrawPlasma;
Var
    i,j,color,
    tpos1,tpos2,
    tpos3,tpos4     : Byte;
    where                    : Word;
Begin
    tpos3:=pos3;
    tpos4:=pos4;
  where:=0;

    Asm
        mov        ax,0a000h
        mov   es,ax
    End;

    { 50 rows down }
    For i:=1 to 50 do
    Begin
        tpos1:=pos1;
        tpos2:=pos2;

        { 80 columns across }
        For j:=1 to 80 do
        Begin
            { color in the intersection of numerous cos waves }
            color :=     CosTbl[tpos1]+CosTbl[tpos2]+CosTbl[tpos3]+
                                CosTbl[tpos4]+CosTbl[i]+CosTbl[j];

            Asm
                mov        di,where
                mov   al,color
                mov   es:[di],al
            End;

            where:=where+1;                              { Inc the place to put the pixel }
            tpos1:=tpos1+4;
            tpos2:=tpos2+3;                                { Try out diffrent combination for
                                                                            different effects }
        End;
        tpos3:=tpos3+4;
        tpos4:=tpos4+5;                                { Try it out here to }
    End;
End;

{ Moves the plasma left/right/up/down }
Procedure MovePlasma;
Begin
    pos1:=pos1-4;
    pos3:=pos3+4;
    pos1:=pos1+random(1);
    pos2:=pos2-random(2);
    pos3:=pos3+random(1);
    pos4:=pos4-random(2);
End;

{ Waits for a vertical retrace }
Procedure WaitRetrace; Assembler;
Label
    l1, l2;
Asm
    mov        dx,3DAh
l1:
    in    al,dx
    test  al,8
    jnz   l1
l2:
    in    al,dx
    test  al,8
    jz    l2
End;

{ Fades up the palette ToPal by incrementing by 1 and sets the onscreen
    palette. }
Procedure FadeUpOne(stage:Integer);
Var
    i     : Byte;
    Tmp : RGBType;
Begin
    Move(TempPal,Tmp,3);
    Move(TempPal[1],TempPal[0],765);
    Move(Tmp,TempPal[255],3);

    For i:=0 to 255 do
    Begin
        ToPal[i].R := Integer(TempPal[i].R * stage div 64);
        ToPal[i].G := Integer(TempPal[i].G * stage div 64);
        ToPal[i].B := Integer(TempPal[i].B * stage div 64);
    End;

    SetPal(ToPal);
End;

{ Rotates the palette }
Procedure ShiftPallette;
Var
    Tmp : RGBType;
Begin
    Move(ToPal[0],Tmp,3);
    Move(ToPal[1],ToPal[0],765);
    Move(Tmp,ToPal[255],3);
    SetPal(ToPal);
End;

{ Main plasma routine }
Procedure DoPlasma;
Var
    i : Byte;
Begin
    { Fades up the plasma }
    For i:=1 to 64 do
    Begin
        FadeUpOne(i);
        DrawPlasma;
        MovePlasma;
    End;

    { Do the plasma thing }
    Repeat
        ShiftPallette;
        DrawPlasma;
        MovePlasma;
        {WaitRetrace;} { Use this if you have flicker! }
    Until Keypressed;

    { Fades down the plasma }
    Move(ToPal,TempPal,768);
    For i:=1 to 64 do
    Begin
        FadeUpOne(64-i);
        DrawPlasma;
        MovePlasma;
    End;

    While keypressed do readkey;

    { Back to text mode }
    Asm
        mov  ax,0003h
        int  10h
    End;
End;

Begin
    InitPlasma;
    DoPlasma;
End.